Celestin Apprentice 4/Apprentice-Release4.iso/Languages/CW MacMindy 1.4/Examples/QD3D-Viewer/Toolbox-Library Sources/Toolbox.dyl

Text File | 1995-11-14 | 29.2 KB | 876 lines | [TEXT/CWIE]

module: Toolbox

define module Toolbox
    use Dylan;                            // all programs need this.
    use Extensions;                        // imports "main"
    use Extern;                            // imports "load-object-file", etc.

    export
        get-c-function, Debugger, DebugStr,

        $nil, $noErr,

        <Ptr>,     NewPtr, DisposePtr,
        <Handle>, NewHandle, DisposeHandle, HLock, HLockHi, HUnlock,
        FreeMem,

        <Pascal-string>,

        <OSErr>, <OSType>, os-type,

        <Point>, point-v, point-v-setter, point-h, point-h-setter,
        point,

        <Rect>, top, top-setter, left, left-setter,
                bottom, bottom-setter, right, right-setter,

        // Resource Manager.
        GetResource, ReleaseResource,

        // Sound Manager.
        SysBeep, SndPlay,

        // Event Manager.
        $everyEvent,
        $nullEvent, $mouseDown, $mouseUp, $keyDown, $keyUp, $autoKey, $updateEvt, $diskEvt, $activateEvt,
        $osEvt, $kHighLevelEvent,
        $cmdKey,
        <EventRecord>, event-what, event-message, event-when, event-where, event-modifiers,
        GetNextEvent, SystemTask, WaitNextEvent,
        AEProcessAppleEvent,

        TickCount, Button, WaitMouseUp, GetMouse,

        // QuickDraw.
        <BitMap>, bounds, <QDGlobals>, screenBits, arrow, qd,
        <RgnHandle>, NewRgn, DisposeRgn, SetEmptyRgn, SetRectRgn, RectRgn,

        <PicHandle>, DrawPicture,

        <GrafPtr>, <CGrafPtr>, portRect, SetPort,
        MoveTo, LineTo, DrawString, TextFont,

        EraseRect, FrameRect, InvertRect, PaintRect,
        GetClip, SetClip,

        PtInRect,

        // Cursors.
        InitCursor, HideCursor, ShowCursor,
        <Cursor>, <CursHandle>, GetCursor, SetCursor,

        // Fonts.
        GetFNum,

        // Window Manager.
        <WindowPtr>,
        FrontWindow, ShowWindow, HideWindow, SelectWindow, SetWTitle,
        GetNewWindow, GetNewCWindow, DisposeWindow, BeginUpdate, EndUpdate, DrawGrowIcon,
        FindWindow,
        $inDesk, $inMenuBar, $inSysWindow, $inContent, $inDrag, $inGrow, $inGoAway, $inZoomIn, $inZoomOut,
        DragWindow, TrackGoAway, TrackBox, ZoomWindow, GrowWindow, SizeWindow,

        // Dialog Manager.
        <DialogPtr>, <ModalFilterUPP>, Alert,

        // Menu Manager.
        <MenuBarHandle>, <MenuHandle>,
        GetNewMBar, SetMenuBar, DrawMenuBar, HiliteMenu,
        MenuSelect, MenuKey,
        GetMenuHandle, CountMItems, GetMenuItemText, EnableItem, DisableItem,
        AppendResMenu,

        // Desk Accessories.
        OpenDeskAcc,

        // OS Utils.
        <DateTimeRec>, year, month, day, hour, minute, seconds, dayOfWeek,
        GetDateTime, SecondsToDate,

        // Files.
        <FSSpec>, vRefNum, parID, name,
        FSMakeFSSpec, FSpOpenDF, FSClose,
        $fsRdPerm, $fsWrPerm, $fsRdWrPerm, $fsRdWrShPerm,

        <StandardFileReply>, sfGood, sfFile,
        StandardGetFile
end module Toolbox;

// This is potentially useful, but will probably be overshadowed by Melange.
// It combines the functionality of "find-c-function" and
// "constrain-c-function" to get usable function in one step.

define constant gcf-unbound = pair(#f, #f); // hack

define method get-c-function (name :: <string>, #key args, rest = ~args,
                                result = <object>, file = gcf-unbound)
 => (result :: <c-function>);
  let real-args = if (args) as(<list>, args) else #() end if;
  let real-result = if (instance?(result, <sequence>)) as(<list>, result)
            else list(result)
            end if;
  let fun = if (file == gcf-unbound)
          find-c-function(name)
        else
          find-c-function(name, file: file);
        end if;
  fun & constrain-c-function(fun, real-args, rest, real-result);
end method get-c-function;

define constant *InterfaceLib* = load-object-file(#("InterfaceLib"));

// Low-Level Debugger.

define constant Debugger = get-c-function("Debugger", args: #(),
                                            result: #(), file: *InterfaceLib*);
define constant DebugStr = get-c-function("DebugStr", args: list(<Pascal-string>),
                                            result: #(), file: *InterfaceLib*);

// Memory Manager.

define constant $nil = as(<statically-typed-pointer>, 0);
define constant $noErr = 0;

// <Ptr>

define class <Ptr> (<statically-typed-pointer>) end class;

define constant NewPtr = get-c-function("NewPtr", args: list(<integer>),
                                            result: <Ptr>, file: *InterfaceLib*);
define constant DisposePtr = get-c-function("DisposePtr", args: list(<Ptr>),
                                            result: #(), file: *InterfaceLib*);

define method destroy (pointer :: <Ptr>) => ();
  DisposePtr(pointer);
end method destroy;

define class <Handle> (<statically-typed-pointer>) end class;

define constant NewHandle = get-c-function("NewHandle", args: list(<integer>),
                                            result: <Handle>, file: *InterfaceLib*);
define constant DisposeHandle = get-c-function("DisposeHandle", args: list(<Handle>),
                                            result: #(), file: *InterfaceLib*);

define constant HLock = get-c-function("HLock", args: list(<Handle>),
                                            result: #(), file: *InterfaceLib*);
define constant HLockHi = get-c-function("HLockHi", args: list(<Handle>),
                                            result: #(), file: *InterfaceLib*);
define constant HUnlock = get-c-function("HUnlock", args: list(<Handle>),
                                            result: #(), file: *InterfaceLib*);

define method destroy (handle :: <Handle>) => ();
  DisposeHandle(handle);
end method destroy;


define constant FreeMem = get-c-function("FreeMem", args: #(),
                                            result: <integer>, file: *InterfaceLib*);

// Pascal Strings.

define class <Pascal-string> (<string>, <Ptr>)
end class <Pascal-string>;

define method as (cls == <Pascal-string>, str :: <Pascal-string>) => (result :: <Pascal-string>);
  str;
end method as;

define method make(cls :: limited(<class>, subclass-of: <Pascal-string>),
                           #key size: sz = 0, fill = ' ')
  let result = as(cls, NewPtr(256));
  let fill-byte = as(<integer>, fill);
  for (i from 1 to sz)
    unsigned-byte-at(result, offset: i) := fill-byte;
  end for;
  unsigned-byte-at(result, offset: 0) := sz;
  result;
end method make;

define method forward-iteration-protocol(str :: <Pascal-string>)
  values(0, #f,
     method (str, state) state + 1 end method,
     method (str, state, limit)
       limit >= unsigned-byte-at(str);
     end method,
     method (str, state) state end method,
     method (str, state)
       as(<character>, unsigned-byte-at(str, offset: state + 1));
     end method,
     method (value :: <character>, str, state)
       unsigned-byte-at(str, offset: state + 1) := as(<integer>, value);
     end method,
     method (str, state) state end method);
end method forward-iteration-protocol;

/*
define method \< (str1 :: <Pascal-string>, str2 :: <Pascal-string>)
 => result :: <object>;
  for (c1 in str1, c2 in str2, while c1 < c2)
  finally
    #t;
  end for;
end method \<;
*/

define method size (string :: <Pascal-string>) => result :: <integer>;
    unsigned-byte-at(string, offset: 0);
end method size;

define method size-setter (new-size :: <integer>, string :: <Pascal-string>)
    unsigned-byte-at(string, offset: 0) := new-size;
end method size-setter;

define method element (string :: <Pascal-string>, index :: <integer>, #key default: def) => <character>;
  as(<character>, unsigned-byte-at(string, offset: index + 1));
end method element;

define method element-setter (value :: <character>, string :: <Pascal-string>, index :: <integer>)
  unsigned-byte-at(string, offset: index + 1) := as(<integer>, value);
end method element-setter;

// This is a very common operation, so let's make it fast.

define method as (cls == <Pascal-string>, str :: <byte-string>)
  let sz = str.size;
  let result = as(<Pascal-string>, NewPtr(256));
  for (i from 1 to sz)
    unsigned-byte-at(result, offset: i) := as(<integer>, str[i - 1]);
  end for;
  unsigned-byte-at(result, offset: 0) := sz;
  result;
end method as;

// This is a very common operation, so let's make it fast.
//
define method as (cls == <byte-string>, str :: <Pascal-string>)
  let sz = str.size;
  let result = make(<string>, size: sz);
  for (i from 0 below sz)
    result[i] := as(<character>, unsigned-byte-at(str, offset: i + 1));
  end for;
  result;
end method as;

// OSErr.

define constant <OSErr> = <integer>;

// OSType.

define constant <OSType> = <extended-integer>;

define constant os-type = method (typestr :: <string>) => (result :: <OSType>);
    let type = as(<OSType>, as(<integer>, typestr[0]));
    for (i from 1 below 4)
        type := type * 256 + as(<integer>, typestr[i]);
    finally
        type;
    end for;
end method;

// Points.

define class <Point> (<Ptr>) end class;

define method point-v (pt :: <Point>) => (v :: <integer>);
    signed-short-at(pt, offset: 0);
end method point-v;

define method point-v-setter (value :: <integer>, pt :: <Point>) => (value :: <integer>);
    signed-short-at(pt, offset: 0) := value;
end method point-v-setter;

define method point-h (pt :: <Point>) => (h :: <integer>);
    signed-short-at(pt, offset: 2);
end method point-h;

define method point-h-setter (value :: <integer>, pt :: <Point>) => (value :: <integer>);
    signed-short-at(pt, offset: 2) := value;
end method point-h-setter;

define method point (x :: <integer>, y :: <integer>) => (pt :: <Point>);
    let pt = as (<Point>, NewPtr(4));
    pt.point-v := y;
    pt.point-h := x;
    pt;
end method point;

define method make(cls == <Point>, #key v: pv = 0, h: ph = 0)
  let pt = as(<Point>, NewPtr(4));
    pt.point-v := pv;
    pt.point-h := ph;
  pt;
end method make;

define method as (cls == <integer>, pt :: <Point>) => (result :: <integer>);
    as(<extended-integer>, signed-long-at(pt));
//    as(<integer>, signed-long-at(pt));
end method as;

// Rectangles.

define class <Rect> (<Ptr>) end class;

define method top (rect :: <Rect>) => (top :: <integer>);
    signed-short-at(rect, offset: 0);
end method top;

define method top-setter (value :: <integer>, rect :: <Rect>) => (top :: <integer>);
    signed-short-at(rect, offset: 0) := value;
end method top-setter;

define method left (rect :: <Rect>) => (left :: <integer>);
    signed-short-at(rect, offset: 2);
end method left;

define method left-setter (value :: <integer>, rect :: <Rect>) => (left :: <integer>);
    signed-short-at(rect, offset: 2) := value;
end method left-setter;

define method bottom (rect :: <Rect>) => (bottom :: <integer>);
    signed-short-at(rect, offset: 4);
end method bottom;

define method bottom-setter (value :: <integer>, rect :: <Rect>) => (bottom :: <integer>);
    signed-short-at(rect, offset: 4) := value;
end method bottom-setter;

define method right (rect :: <Rect>) => (right :: <integer>);
    signed-short-at(rect, offset: 6);
end method right;

define method right-setter (value :: <integer>, rect :: <Rect>) => (right :: <integer>);
    signed-short-at(rect, offset: 6) := value;
end method right-setter;

define method make(cls == <Rect>, #key top: t = 0, left: l = 0,
                        bottom: b = 0, right: r = 0)
  let rect = as(<Rect>, NewPtr(8));
  rect.top := t;
  rect.left := l;
  rect.bottom := b;
  rect.right := r;
  rect;
end method make;

// this one's harder to express using Toolbox interface.

/*
define constant PtInRect = method (pt :: <Point>, rect :: <Rect>) => (result :: <Boolean>);
    (pt.point-v >= rect.top &
     pt.point-h >= rect.left &
     pt.point-v <= rect.bottom &
     pt.point-h <= rect.right);
end method;
*/

define constant PtInRect =
begin
    let func = get-c-function("PtInRect", args: list(<integer>, <Rect>),
                                            result: <boolean>, file: *InterfaceLib*);
    method (pt :: <Point>, rect :: <Rect>) => (result :: <boolean>);
        func(as(<integer>, pt), rect);
    end method;
end;

// Resource Manager.

define constant GetResource = get-c-function("GetResource", args: list(<OSType>, <integer>),
                                            result: <Handle>, file: *InterfaceLib*);
define constant ReleaseResource = get-c-function("ReleaseResource", args: list(<Handle>),
                                            result: #(), file: *InterfaceLib*);

// Sound Manager.

define constant SysBeep = get-c-function("SysBeep", args: list(<integer>),
                                            result: #(), file: *InterfaceLib*);

define class <SndChannel> (<Ptr>) end class;

define constant SndPlay = get-c-function("SndPlay", args: list(<SndChannel>, <Handle>, <boolean>),
                                            result: <OSErr>, file: *InterfaceLib*);

// Event Manager.

define constant $everyEvent = -1;

// event codes.
define constant $nullEvent = 0;
define constant $mouseDown = 1;
define constant $mouseUp = 2;
define constant $keyDown = 3;
define constant $keyUp = 4;
define constant $autoKey = 5;
define constant $updateEvt = 6;
define constant $diskEvt = 7;
define constant $activateEvt = 8;
define constant $osEvt = 15;
define constant $kHighLevelEvent = 23;

// modifier masks.
define constant $cmdKey = 256;

define class <EventRecord> (<Ptr>) end class;

define method make(cls == <EventRecord>, #key what: what)
    as(<EventRecord>, NewPtr(16));
end method make;

define method event-what (event :: <EventRecord>) => (what :: <integer>);
    signed-short-at(event, offset: 0);
end method event-what;

define method event-message (event :: <EventRecord>) => (message :: <integer>);
    unsigned-long-at(event, offset: 2);
end method event-message;

define method event-when (event :: <EventRecord>) => (when :: <integer>);
    unsigned-long-at(event, offset: 6);
end method event-when;

define method event-where (event :: <EventRecord>) => (where :: <Point>);
    as (<Point>, event + 10);
end method event-where;

define method event-modifiers (event :: <EventRecord>) => (modifiers :: <integer>);
    signed-short-at(event, offset: 14);
end method event-modifiers;

define constant GetNextEvent = get-c-function("GetNextEvent", args: list(<integer>, <EventRecord>),
                                            result: <boolean>, file: *InterfaceLib*);
define constant SystemTask = get-c-function("SystemTask", args: #(),
                                            result: #(), file: *InterfaceLib*);
define constant WaitNextEvent = get-c-function("WaitNextEvent", args: list(<integer>, <EventRecord>, <integer>, <RgnHandle>),
                                            result: <boolean>, file: *InterfaceLib*);

define constant AEProcessAppleEvent = get-c-function("AEProcessAppleEvent", args: list(<EventRecord>),
                                            result: <OSErr>, file: *InterfaceLib*);

define constant TickCount = get-c-function("TickCount", args: #(),
                                            result: <integer>, file: *InterfaceLib*);

define constant Button = get-c-function("Button", args: #(),
                                            result: <boolean>, file: *InterfaceLib*);
define constant WaitMouseUp = get-c-function("WaitMouseUp", args: #(),
                                            result: <boolean>, file: *InterfaceLib*);

define constant GetMouse = get-c-function("GetMouse", args: list(<Point>),
                                            result: #(), file: *InterfaceLib*);

// QuickDraw.

define class <BitMap> (<statically-typed-pointer>) end class;

define method bounds (bitmap :: <BitMap>) => (result :: <Rect>);
    as(<Rect>, bitmap + 6);
end method;

define class <QDGlobals> (<statically-typed-pointer>) end class;

define method screenBits (qd :: <QDGlobals>) => (result :: <BitMap>);
    as(<BitMap>, qd + 80);
end method;

define method arrow (qd :: <QDGlobals>) => (result :: <Cursor>);
    as(<Cursor>, qd + 94);
end method;

define constant qd = as(<QDGlobals>, find-c-pointer("qd"));

define class <RgnHandle> (<Handle>) end class;

define constant NewRgn = get-c-function("NewRgn", args: #(),
                                            result: <RgnHandle>, file: *InterfaceLib*);
define constant DisposeRgn = get-c-function("DisposeRgn", args: list(<RgnHandle>),
                                            result: #(), file: *InterfaceLib*);
define constant SetEmptyRgn = get-c-function("SetEmptyRgn", args: list(<RgnHandle>),
                                            result: #(), file: *InterfaceLib*);
define constant SetRectRgn = get-c-function("SetRectRgn", args: list(<RgnHandle>, <integer>, <integer>, <integer>, <integer>),
                                            result: #(), file: *InterfaceLib*);
define constant RectRgn = get-c-function("RectRgn", args: list(<RgnHandle>, <Rect>),
                                            result: #(), file: *InterfaceLib*);

define class <PicHandle> (<Handle>) end class;
define constant DrawPicture = get-c-function("DrawPicture", args: list(<PicHandle>),
                                            result: #(), file: *InterfaceLib*);

define class <GrafPtr> (<Ptr>) end class;

define constant <CGrafPtr> = <GrafPtr>;

define method portRect (port :: <GrafPtr>)
    as(<Rect>, port + 16);
end method;

define constant SetPort = get-c-function("SetPort", args: list(<GrafPtr>),
                                            result: #(), file: *InterfaceLib*);

define constant MoveTo = get-c-function("MoveTo", args: list(<integer>, <integer>),
                                            result: #(), file: *InterfaceLib*);
define constant LineTo = get-c-function("LineTo", args: list(<integer>, <integer>),
                                            result: #(), file: *InterfaceLib*);
define constant DrawString = get-c-function("DrawString", args: list(<string>),
                                            result: #(), file: *InterfaceLib*);
define constant TextFont = get-c-function("TextFont", args: list(<integer>),
                                            result: #(), file: *InterfaceLib*);

define constant EraseRect = get-c-function("EraseRect", args: list(<Rect>),
                                            result: #(), file: *InterfaceLib*);
define constant FrameRect = get-c-function("FrameRect", args: list(<Rect>),
                                            result: #(), file: *InterfaceLib*);
define constant InvertRect = get-c-function("InvertRect", args: list(<Rect>),
                                            result: #(), file: *InterfaceLib*);
define constant PaintRect = get-c-function("PaintRect", args: list(<Rect>),
                                            result: #(), file: *InterfaceLib*);

// Clipping.

define constant GetClip = get-c-function("GetClip", args: list(<RgnHandle>),
                                            result: #(), file: *InterfaceLib*);
define constant SetClip = get-c-function("SetClip", args: list(<RgnHandle>),
                                            result: #(), file: *InterfaceLib*);

// Cursors.

define constant InitCursor = get-c-function("InitCursor", args: #(),
                                            result: #(), file: *InterfaceLib*);
define constant HideCursor = get-c-function("HideCursor", args: #(),
                                            result: #(), file: *InterfaceLib*);
define constant ShowCursor = get-c-function("ShowCursor", args: #(),
                                            result: #(), file: *InterfaceLib*);

define class <Cursor> (<Ptr>) end class;
define class <CursHandle> (<Handle>) end class;

define constant GetCursor = get-c-function("GetCursor", args: list(<integer>),
                                            result: <CursHandle>, file: *InterfaceLib*);
define constant SetCursor = get-c-function("SetCursor", args: list(<Cursor>),
                                            result: #(), file: *InterfaceLib*);

// Fonts.

define constant GetFNum =
begin
    let func = get-c-function("GetFNum", args: list(<Pascal-string>, <Ptr>),
                                result: #(), file: *InterfaceLib*);
    method(fontName :: <Pascal-string>) => (fontNumber :: <integer>);
        let fontNumPtr = stack-alloc(<Ptr>, 2);    // sizeof(short).
        func(fontName, fontNumPtr);
        signed-short-at(fontNumPtr);
    end method;
end;

// Windows.

define constant <WindowPtr> = <GrafPtr>;

define constant FrontWindow = get-c-function("FrontWindow", args: #(),
                                            result: <WindowPtr>, file: *InterfaceLib*);
define constant ShowWindow = get-c-function("ShowWindow", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);
define constant HideWindow = get-c-function("HideWindow", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);
define constant SelectWindow = get-c-function("SelectWindow", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);
define constant SetWTitle = get-c-function("SetWTitle", args: list(<WindowPtr>, <Pascal-string>),
                                            result: #(), file: *InterfaceLib*);

define constant GetNewWindow =
begin
    let func = get-c-function("GetNewWindow", args: list(<integer>, <WindowPtr>, <WindowPtr>),
                                result: <WindowPtr>, file: *InterfaceLib*);
    method (windowID :: <integer>, #key storage: st = as(<WindowPtr>, 0), behind: bw = as(<WindowPtr>, -1))
        func(windowID, st, bw);
    end method;
end;

define constant GetNewCWindow =
begin
    let func = get-c-function("GetNewCWindow", args: list(<integer>, <WindowPtr>, <WindowPtr>),
                                result: <WindowPtr>, file: *InterfaceLib*);
    method (windowID :: <integer>, #key storage: st = as(<WindowPtr>, 0), behind: bw = as(<WindowPtr>, -1))
        func(windowID, st, bw);
    end method;
end;

define constant DisposeWindow = get-c-function("DisposeWindow", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);

define constant BeginUpdate = get-c-function("BeginUpdate", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);
define constant EndUpdate = get-c-function("EndUpdate", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);
define constant DrawGrowIcon = get-c-function("DrawGrowIcon", args: list(<WindowPtr>),
                                            result: #(), file: *InterfaceLib*);

define constant FindWindow =
begin
    let func = get-c-function("FindWindow", args: list(<integer>, <Ptr>),
                                result: <integer>, file: *InterfaceLib*);
    method (pt :: <Point>) => (partCode :: <integer>, window :: <WindowPtr>);
        // need storage to hold pointer to the WindowPtr.
        let whichWindow = stack-alloc(<Ptr>, 4);
        let partCode = func(as(<integer>, pt), whichWindow);
        values(partCode, as(<WindowPtr>, pointer-at(whichWindow)));
    end method;
end;

define constant $inDesk = 0;
define constant $inMenuBar = 1;
define constant $inSysWindow = 2;
define constant $inContent = 3;
define constant $inDrag = 4;
define constant $inGrow = 5;
define constant $inGoAway = 6;
define constant $inZoomIn = 7;
define constant $inZoomOut = 8;

define constant DragWindow =
begin
    let func = get-c-function("DragWindow", args: list(<WindowPtr>, <integer>, <Rect>),
                                result: #(), file: *InterfaceLib*);
    method (window :: <WindowPtr>, clickPt :: <Point>, #key bounds: bnds :: <Rect> = qd.screenBits.bounds) => ();
        func(window, as(<integer>, clickPt), bnds);
    end method;
end;

define constant TrackGoAway =
begin
    let func = get-c-function("TrackGoAway", args: list(<WindowPtr>, <integer>),
                                result: <boolean>, file: *InterfaceLib*);
    method (window :: <WindowPtr>, clickPt :: <Point>) => (result :: <boolean>);
        func(window, as(<integer>, clickPt));
    end method;
end;

define constant TrackBox =
begin
    let func = get-c-function("TrackBox", args: list(<WindowPtr>, <integer>, <integer>),
                                result: <boolean>, file: *InterfaceLib*);
    method (window :: <WindowPtr>, clickPt :: <Point>, partCode :: <integer>) => (result :: <boolean>);
        func(window, as(<integer>, clickPt), partCode);
    end method;
end;

define constant ZoomWindow = get-c-function("ZoomWindow", args: list(<WindowPtr>, <integer>, <boolean>),
                                            result: #(), file: *InterfaceLib*);

define constant GrowWindow =
begin
    let func = get-c-function("GrowWindow", args: list(<WindowPtr>, <integer>, <Rect>),
                                result: <extended-integer>, file: *InterfaceLib*);
    method (window :: <WindowPtr>, clickPt :: <Point>, sizeRect :: <Rect>)
      => (height :: <integer>, width :: <integer>);
        let result = func(window, as(<integer>, clickPt), sizeRect);
        floor/(result, 65536);    // split up the upper and lower halves of the result.
    end method;
end;

define constant SizeWindow = get-c-function("SizeWindow", args: list(<WindowPtr>, <integer>, <integer>, <boolean>),
                                            result: #(), file: *InterfaceLib*);

// Dialogs.

define constant <DialogPtr> = <GrafPtr>;
define class <ModalFilterUPP> (<statically-typed-pointer>) end class;

define constant Alert =
begin
    let func = get-c-function("Alert", args: list(<integer>, <ModalFilterUPP>),
                                result: <integer>, file: *InterfaceLib*);
    method (id :: <integer>, #key filter: flt = #f)
        if (~flt)
            flt := as(<ModalFilterUPP>, 0);
        end if;
        func(id, flt);
    end method;
end;

// Menu Manager.

define class <MenuBarHandle> (<Handle>) end class;
define class <MenuHandle> (<Handle>) end class;

define constant GetNewMBar = get-c-function("GetNewMBar", args: list(<integer>),
                                            result: <MenuBarHandle>, file: *InterfaceLib*);
define constant SetMenuBar = get-c-function("SetMenuBar", args: list(<MenuBarHandle>),
                                            result: #(), file: *InterfaceLib*);
define constant DrawMenuBar = get-c-function("DrawMenuBar", args: #(),
                                            result: #(), file: *InterfaceLib*);
define constant HiliteMenu = get-c-function("HiliteMenu", args: list(<integer>),
                                            result: #(), file: *InterfaceLib*);

// Note:  the following use <extended-integer> because all 32-bits of the result are significant.

define constant MenuSelect =
begin
    let func = get-c-function("MenuSelect", args: list(<integer>),
                                            result: <extended-integer>, file: *InterfaceLib*);
    method (clickPt :: <Point>) => (menu :: <integer>, item :: <integer>);
        let result = func(as(<integer>, clickPt));
        floor/(result, 65536);
//        let (menu, item) = floor/(result, 65536);
//        values(menu, item);
//        values(as(<fixed-integer>, menu), as(<fixed-integer>, item));
    end method;
end;

define constant MenuKey =
begin
    let func = get-c-function("MenuKey", args: list(<integer>),
                                            result: list(<extended-integer>), file: *InterfaceLib*);
    method (ch :: <character>) => (menu :: <integer>, item :: <integer>);
        let result = func(as(<integer>, ch));
        floor/(result, 65536);
//        let (menu, item) = floor/(result, 65536);
//        values(menu, item);
//        values(as(<fixed-integer>, menu), as(<fixed-integer>, item));
    end method;
end;

define constant GetMenuHandle = get-c-function("GetMenuHandle", args: list(<integer>),
                                            result: <MenuHandle>, file: *InterfaceLib*);
define constant CountMItems = get-c-function("CountMItems", args: list(<MenuHandle>),
                                            result: <integer>, file: *InterfaceLib*);
define constant GetMenuItemText = get-c-function("GetMenuItemText",
                                            args: list(<MenuHandle>, <integer>, <Pascal-string>),
                                            result: <integer>, file: *InterfaceLib*);
define constant EnableItem = get-c-function("EnableItem", args: list(<MenuHandle>, <integer>),
                                            result: #(), file: *InterfaceLib*);
define constant DisableItem = get-c-function("DisableItem", args: list(<MenuHandle>, <integer>),
                                            result: #(), file: *InterfaceLib*);

// adding resource types to menus.

define constant AppendResMenu = get-c-function("AppendResMenu", args: list(<MenuHandle>, <OSType>),
                                            result: #(), file: *InterfaceLib*);

// Desk Accessory Support.

define constant OpenDeskAcc = get-c-function("OpenDeskAcc",
                                            args: list(<Pascal-string>),
                                            result: <integer>, file: *InterfaceLib*);

// OSUtils.

define constant GetDateTime =
begin
    let func = get-c-function("GetDateTime", args: list(<Ptr>),
                                            result: #(), file: *InterfaceLib*);
    method () => (time :: <integer>);
        let longPtr = stack-alloc(<Ptr>, 4);    // sizeof(long)
        func(longPtr);
        let time = as(<extended-integer>, unsigned-short-at(longPtr));
        time * 65536 + as(<extended-integer>, unsigned-short-at(longPtr, offset: 2));
    end method;
end;

define class <DateTimeRec> (<Ptr>) end class;

define method year (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 0);
end method year;

define method month (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 2);
end method month;

define method day (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 4);
end method day;

define method hour (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 6);
end method hour;

define method minute (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 8);
end method minute;

define method seconds (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 10);
end method seconds;

define method dayOfWeek (dateTime :: <DateTimeRec>) => (result :: <integer>);
    signed-short-at(dateTime, offset: 12);
end method dayOfWeek;

define constant SecondsToDate = get-c-function("SecondsToDate", args: list(<extended-integer>, <DateTimeRec>),
                                            result: #(), file: *InterfaceLib*);

// Files.

define class <FSSpec> (<Ptr>) end class;

define method vRefNum (spec :: <FSSpec>) => (result :: <integer>);
    signed-short-at(spec, offset: 0);
end method vRefNum;

define method parID (spec :: <FSSpec>) => (result :: <integer>);
    signed-long-at(spec, offset: 2);
end method parID;

define method name (spec :: <FSSpec>) => (result :: <Pascal-string>);
    as(<Pascal-string>, spec + 6);
end method name;

define constant FSMakeFSSpec =
begin
    // need storage to hold pointer to the WindowPtr.
    let func = get-c-function("FSMakeFSSpec",
                                args: list(<integer>, <integer>, <Pascal-string>, <FSSpec>),
                                result: <OSErr>, file: *InterfaceLib*);
    method (volume :: <integer>, directory, name :: <Pascal-string>)
     => (result :: <OSErr>, spec :: <FSSpec>);
        let spec = as(<FSSpec>, NewPtr(70));
        let result = func(volume, directory, name, spec);
        values(result, spec);
    end method;
end;

define constant $fsRdPerm = 1;
define constant $fsWrPerm = 2;
define constant $fsRdWrPerm = 3;
define constant $fsRdWrShPerm = 4;

define constant FSpOpenDF =
begin
    // need storage to hold pointer to the WindowPtr.
    let refNumPtr = NewPtr(2);
    let func = get-c-function("FSpOpenDF", args: list(<FSSpec>, <integer>, <Ptr>),
                                result: <integer>, file: *InterfaceLib*);
    method (spec :: <FSSpec>, permission :: <integer>)
     => (result :: <OSErr>, refNum :: <integer>);
        let result = func(spec, permission, refNumPtr);
        values(result, signed-short-at(refNumPtr));
    end method;
end;

define constant FSClose = get-c-function("FSClose",
                                        args: list(<integer>),
                                        result: <OSErr>, file: *InterfaceLib*);

define class <StandardFileReply> (<Ptr>) end class;

define method sfGood (reply :: <StandardFileReply>) => (result :: <boolean>);
    signed-byte-at(reply, offset: 0) ~= 0;
end method sfGood;

define method sfFile (reply :: <StandardFileReply>) => (result :: <FSSpec>);
    as(<FSSpec>, reply + 6);
end method sfFile;

define method make(cls == <StandardFileReply>, #key, #all-keys)
  as(<StandardFileReply>, NewPtr(88));
end method make;

define constant StandardGetFile =
begin
    let func = get-c-function("StandardGetFile", args: list(<Ptr>, <integer>, <Ptr>, <StandardFileReply>),
                                result: #(), file: *InterfaceLib*);
    method (reply :: <StandardFileReply>) => (result :: <boolean>);
        func($nil, -1, $nil, reply);
        reply.sfGood;
    end method;
end;